home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac 1993 September / September 93.iso / Archives / Applications / Text / Text Editors / Alpha 5.31 Folder / Tcl / SystemCode / procs.tcl < prev    next >
Encoding:
Text File  |  1993-02-14  |  9.7 KB  |  443 lines  |  [TEXT/ALFA]
  1. # 'pete' is used in the rest of the file to determine if this is we
  2. # are sitting on someone else's disk.
  3. set pete [expr [file exists "Internal:C:Alpha:Alpha"]?1:0]
  4. set Tcl [expr {$pete ? {Internal:C:Alpha:Tcl 6.2} : "$HOME"}]
  5.  
  6. #===============================================================================================
  7. # Appends all the 'noGlobNecessary' elements with globs of 'globNecessary' elements to create
  8. # the penultimate list file sets. Also calls Alpha and tells it the new list of file set names.
  9. # It is easy to create large filesets by using the 'glob' Tcl command. All that is really 
  10. # necessary is to provide Alpha with a list of fileset names and a way to retrieve the contents
  11. # of a given fileset.
  12. #===============================================================================================
  13.  
  14. if ($pete) {
  15.     addMenuItem Misc "(-"
  16.     addMenuItem Misc createStuffitArchive
  17.     addMenuItem Misc backupSource
  18.     set globNecessary {
  19.         {Edit "$HOME:EditSource:*.c"}}
  20.     set noGlobNecessary { 
  21.         { Alpha 
  22.             "$HOME:EditSource:emacs.c"
  23.             "$HOME:EditSource:dir.c"
  24.             "$HOME:EditSource:alloca.c"
  25.             "$HOME:EditSource:bindings.c"
  26.             "$HOME:EditSource:command.c"
  27.             "$HOME:EditSource:file_set.c"
  28.             "$HOME:EditSource:search.c"
  29.             "$HOME:EditSource:text.c"
  30.             "$HOME:EditSource:undo.c"
  31.             "$HOME:EditSource:varargs.c"
  32.             "$HOME:EditSource:windows.c"
  33.             "$HOME:EditSource:dirT.c"
  34.             "$HOME:EditSource:frills.c"
  35.             "$HOME:EditSource:io.c"
  36.             "$HOME:EditSource:key.c"
  37.             "$HOME:EditSource:localTcl.c"
  38.             "$HOME:EditSource:moreTcl.c"
  39.             "$HOME:EditSource:shell.c"
  40.             "$HOME:EditSource:main.c"
  41.             "$HOME:EditSource:misc.c"
  42.             "$HOME:EditSource:options.c"
  43.             "$HOME:EditSource:port.c"
  44.             "$HOME:EditSource:redraw.c"
  45.             "$HOME:EditSource:alfRegexp.c"
  46.             "$HOME:EditSource:wmanager.c"
  47.             "$Tcl:panic.c"
  48.             "$Tcl:tclMac.c"
  49.             "$Tcl:tclMacUtil.c"
  50.             "$Tcl:tclAssem.c"
  51.             "$Tcl:tclBasic.c"
  52.             "$Tcl:tclCkalloc.c"
  53.             "$Tcl:tclCmdAH.c"
  54.             "$Tcl:tclCmdIL.c"
  55.             "$Tcl:tclCmdMZ.c"
  56.             "$Tcl:tclEnv.c"
  57.             "$Tcl:tclExpr.c"
  58.             "$Tcl:tclGet.c"
  59.             "$Tcl:tclGlob.c"
  60.             "$Tcl:tclHash.c"
  61.             "$Tcl:tclHistory.c"
  62.             "$Tcl:tclParse.c"
  63.             "$Tcl:tclProc.c"
  64.             "$Tcl:tclUnixAZ.c"
  65.             "$Tcl:tclUnixStr.c"
  66.             "$Tcl:tclUnixUtil.c"
  67.             "$Tcl:tclUtil.c"
  68.             "$Tcl:tclVar.c"
  69.         }
  70.     }
  71. } else {
  72.     set globNecessary {
  73.         {HomeDir "$HOME:*"}
  74.         {Help "$HOME:Help:*"}
  75.     }
  76.     
  77.     set noGlobNecessary {
  78.         { AlternateHome
  79.             "$HOME:AlphaBits.tcl"
  80.             "$HOME:procs.tcl"}
  81.         { AlternateHelp
  82.             "Alpha Help"
  83.             "Alpha Tcl Extensions"
  84.             "Debugging"
  85.             "keyboard.tex"
  86.             "LaTeX Keys"
  87.             "Regular Expressions"
  88.             "Shells"
  89.             "Tcl"
  90.         }
  91.     }
  92. }
  93.  
  94. # This list takes a string and returns the string w/ all occurances
  95. # of the variable 'HOME' substituted. To work this trick w/ other 
  96. # variables, just declare them as global in the following.
  97. # This routine creates the final fileset list from 'globNecessary' 
  98. # 'noGlobNecessary'. Typically only run at startup.
  99. proc expandFileSets {} {
  100.     global fileSets
  101.     global fileSetNames
  102.     global currFileSet
  103.     global globNecessary
  104.     global noGlobNecessary
  105.  
  106.     uplevel #0 {set globNecessary [substituteVars $globNecessary]}
  107.     uplevel #0 {set noGlobNecessary [substituteVars $noGlobNecessary]}
  108.  
  109.     set fileSets {}
  110.     set fileSetNames {}
  111.     
  112.     foreach item $globNecessary {
  113.         lappend fileSets [linsert [glob [lindex $item 1]] 0 [lindex $item 0]]
  114.         lappend fileSetNames [lindex $item 0]
  115.     }
  116.     foreach item $noGlobNecessary {
  117.         lappend fileSets $item
  118.         lappend fileSetNames [lindex $item 0]
  119.     }
  120.  
  121.     menu -n fileSets -m -p changeFileSet $fileSetNames
  122.     if {[catch {[set currFileSet]}] == "1"} {
  123.         set currFileSet [lindex $fileSetNames 0]
  124.     }
  125. }
  126. if {[catch expandFileSets]} {alertnote "Fileset expansion went wrong."}
  127.  
  128. # Called from Alpha to get list of files for current file set.
  129. proc getCurrFileSet {} {
  130.     global fileSets
  131.     global currFileSet
  132.     foreach set $fileSets {
  133.         if {$currFileSet == [lindex $set 0]} {
  134.             return [lrange $set 1 end]
  135.         }
  136.     }
  137.     error "Unable to find valid file set!"
  138. }
  139.  
  140. # Called from Alpha to get names.
  141. proc getFileSetNames {} {
  142.     global fileSetNames
  143.     return $fileSetNames
  144. }
  145.  
  146. #==============================================================================
  147. proc normalLeftBracket {} {
  148.     insertText "\{"
  149. }
  150. proc normalRightBracket {} {
  151.     insertText "\}"
  152. }
  153. bind '\[' <zs>  normalLeftBracket
  154. bind '\]' <zs>  normalRightBracket
  155. #==============================================================================
  156.  
  157.             
  158. # Select the next or current word. If word already selected, will go to next.
  159. proc hiliteWord {} {
  160.     if {[getPos]!=[selEnd]}    forwardChar
  161.     forwardWord
  162.     set start [getPos]
  163.     backwardWord
  164.     select $start [getPos]
  165. }
  166.  
  167. bind 'h' <z> hiliteWord
  168.  
  169. # For mark stack.
  170. set markName 0
  171. set markStack ""
  172.  
  173.  
  174. #=============================================================================
  175. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  176. #                          "suspendHook", and "resumeHook".
  177. #=============================================================================
  178.  
  179. # Event hooks - set specific modes when files opened.
  180. proc openHook name {
  181.     hookMode $name
  182.     if {$name == {*mpw shell*}} startMPW
  183.     addWinName $name
  184. }
  185.  
  186. # Clean up the mark stack.
  187. proc closeHook name {
  188.     global markStack
  189.     if [llength $markStack] {
  190.         set markStack [removePat $markStack $name*]
  191.     }
  192.     removeWinName $name
  193. }
  194.  
  195. proc saveasHook {oldName newName} {
  196.     removeWinName $oldName
  197.     addWinName $newName
  198. }
  199.  
  200.  
  201. proc activateHook name {
  202.     hookMode $name
  203. }
  204.  
  205. proc hookMode name {
  206.     case $name in {
  207.         "*.c"         setCMode
  208.         "*.cc"        setC++Mode
  209.         "*.C"        setC++Mode
  210.         "*.h"         setCMode
  211.         "*.f"          setFortranMode
  212.         "*.tcl"     setTclMode
  213.         {*mpw\ sh*}    setMPWMode
  214.         {*tcl\ sh*}    setShellMode
  215.         "*.tex"        setTexMode
  216.         "*.sty"        setTexMode
  217.         default        setTextMode
  218.     }
  219. }
  220.  
  221.  
  222. # 'modes' is inspected by alpha for the popup mode menu. 'newMode' is 
  223. # called by Alpha in case of a successful choice.
  224. set modes { C C++ Csh Fort MPW Tcl Tex Text }
  225. proc newMode mode {
  226.     case $mode in {
  227.         "C"         setCMode
  228.         "C++"        setC++Mode
  229.         "Csh"         setShellMode
  230.         "Fort"         setFortranMode
  231.         "MPW"        setMPWMode
  232.         "Tcl"         setTclMode
  233.         "Tex"        setTexMode
  234.         "Text"        setTextMode
  235.     }
  236. }
  237.  
  238.  
  239. proc deactivateHook name {
  240. }
  241.  
  242. proc suspendHook name {
  243.     global iconifyOnSwitch
  244.     global suspIconed
  245.     if {$iconifyOnSwitch} {
  246.         set wins [winNames -f]
  247.         foreach win $wins {
  248.             if {![icon -f "$win" -q]} {
  249.                 set suspIconed($win) 1
  250.                 icon -f "$win" -t
  251.             }
  252.         }
  253.     }
  254. }
  255.  
  256. proc resumeHook name {
  257.     global iconifyOnSwitch
  258.     global suspIconed
  259.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  260.         set wins [winNames -f]
  261.         foreach win [array names suspIconed] {
  262.             icon -f "$win" -o
  263.         }
  264.         unset suspIconed
  265.     }
  266. }
  267.  
  268. # Handles dynamically adding and deleting window names from menu.
  269. proc addWinName name {
  270.     global winNameToNum
  271.     global winNumToName
  272.     global fullNames
  273.     
  274.     for {set i 0} {$i<100} {incr i} {
  275.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  276.             if {$fullNames != "0"} {
  277.                 set nm $name
  278.             } else {
  279.                 regexp {[^:]*$} $name nm
  280.             }
  281.             if {$i < 10} {
  282.                 addMenuItem -m -l "/$i" Wins $nm
  283.             } else {
  284.                 addMenuItem -m -l "" Wins $nm
  285.             }
  286.             set winNumToName($i) $name
  287.             set winNameToNum($name) $i
  288.             return
  289.         }
  290.     }
  291. }
  292.  
  293. proc removeWinName name {
  294.     global winNameToNum
  295.     global winNumToName
  296.     global fullNames
  297.     
  298.     set num $winNameToNum($name)
  299.     unset winNumToName($num)
  300.     unset winNameToNum($name)
  301.     if {$fullNames == "1"} {
  302.         deleteMenuItem -m Wins $name
  303.     } else {
  304.         regexp {[^:]*$} $name nm
  305.         deleteMenuItem -m Wins $nm
  306.     }
  307. }
  308.  
  309.  
  310. proc menuWin {menu name} {
  311.     global winNameToNum
  312.  
  313.     set nms [array names winNameToNum]
  314.     foreach nm $nms {
  315.         if {[string match *$name $nm] == "1"}  {
  316.             bringToFront $name
  317.             if [icon -q] { icon -f $name -o }
  318.             return
  319.         }
  320.     }
  321.     return "normal"
  322. }
  323.  
  324.  
  325. set lastMode 0
  326.  
  327. # rta  Creating texWasLast variable
  328. set texWasLast 0
  329. # rta Following changed from ThinkC to MPW
  330.  
  331.  
  332. # Modes
  333.  
  334. # Fortran programming mode 
  335. proc setFortranMode {} {
  336.     changeMode "Fort"
  337.     uplevel #0 {
  338.         set elecLBrace 0
  339.         set elecRBrace 0
  340.         set electricSemi 0
  341.         set wordWrap 0
  342.         set funcExpr {^(      |\t)(subroutine|.*function|SUBROUTINE|.*FUNCTION).*\(.*$}
  343.         set sortedIsDefault 0
  344.         set funcTitle "Func"
  345.     }
  346. }
  347.  
  348.  
  349. # Alpha TCL programming mode
  350. menu -n Tcl {
  351.     "traceTclProc"
  352.     "traceOff"
  353. }
  354.  
  355. # LaTeX mode
  356. proc setTexMode {} {
  357.     changeMode "Tex"
  358.     uplevel #0 {    
  359.         set wordBreakPreface {[^a-zA-Z0-9_]}
  360.         set wordBreak {[a-zA-Z0-9_]+}
  361.         set elecLBrace 0
  362.         set elecRBrace 0
  363.         set electricSemi 0
  364.         set wordWrap 1
  365.         set fillColumn 75
  366.         set prefixString "% "
  367.         set funcTitle "Sect"
  368.         set sortedIsDefault 0
  369.         set funcExpr {^\\(sub)*section\*?{([^{}]*)}}
  370. #        set funcExpr {^\\(sub)*section\*?{(.*)}$}
  371.         set funcPar 2
  372.         set savedIsMeta $optionIsMeta
  373. #        Comment out next line (put "#" in column 0) to use option key 
  374. #       as meta and bind LaTeX macros to option-control in Tex mode.
  375.         if {!$pete} {set optionIsMeta 0}
  376. #        Next is a call to a random proc in the latex file to make sure
  377. #        is it auto-loaded.
  378.         isSelection
  379.         insertMenu "LaTeX"
  380.     }
  381. }
  382.  
  383.  
  384. # Ordinary, default mode
  385. proc setTextMode {} {
  386.     changeMode "Text"
  387.     uplevel #0 {
  388.         set elecLBrace 0
  389.         set elecRBrace 0
  390.         set electricSemi 0
  391.         set wordWrap 1
  392.         set fillColumn 75
  393.         set prefixString "> "
  394.         set suffixString " <--"
  395.     }
  396. }
  397.  
  398.  
  399. proc changeMode {newMode} {
  400.     global lastMode
  401.     global savedIsMeta
  402.     global wordBreak
  403.     global wordBreakPreface
  404.     global optionIsMeta
  405.     
  406.     if {$lastMode == $newMode} {
  407.         displayMode $newMode
  408.         return
  409.     }
  410.     
  411.     displayMode $newMode
  412.     case $lastMode in {
  413.         "Tex" {
  414.             set optionIsMeta $savedIsMeta
  415.             set wordBreakPreface {[^a-zA-Z0-9_]}
  416.             set wordBreak {[a-zA-Z0-9_]+}
  417.             set wordBreak {[a-zA-Z0-9_]+}
  418.             removeMenu "LaTeX"
  419.             set optionIsMeta 1
  420.         }
  421.         "Tcl" {
  422.             removeMenu "Tcl"
  423.         }
  424.     }
  425.     if {[string length $lastMode]} {enableMenuItem Modes $lastMode on}
  426.     enableMenuItem Modes $newMode off
  427.     global mode
  428.     set mode $newMode
  429.     set lastMode $newMode
  430. }
  431.     
  432.  
  433. proc alphaHelp {} {
  434.     global HOME
  435.     edit -r -m "$HOME:Help:Alpha Help"
  436. }
  437.  
  438.  
  439. set patternLibrary {
  440.     { "Pascal to C Comments" {\{([^\}]*)\}} {/* \1 */} }
  441.     { "C++ to C Comments" {//(.*)} {/* \1 */}}
  442. }
  443.